perm filename PTMOVF.FAI[MSS,LCS] blob
sn#255978 filedate 1977-01-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE PTMOVF ********* JUN 8,74 *********
C00012 ENDMK
C⊗;
TITLE PTMOVF; ********* JUN 8,74 *********
INTERNAL LOOK,LOOKD,LOOKF,RCLEF,R4567
ENTRY GETPTS,MOVIT,EXTEN
DEFINE ERROR (MSG)
< JSA 16,.ERROR
JUMP [ASCIZ/MSG/
]
>
.ERROR: 0
OUTSTR [ASCIZ/?
/] ;MAKE SURE HE CAN SEE HIS ERROR
OUTSTR @(16) ;OUTPUT ERROR MESSAGE
CALLI 1,12 ;LET USER CONTI2UE
JRA 16,1(16)
CH←13
REGS: BLOCK 20
;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
LOOKF: 0
MOVSI 0,'DMD'
JRST LOOK1
LOOKD: 0
MOVSI 0,'DAT'
JRST LOOK1
LOOK: 0
MOVEI 0,0
LOOK1: MOVEM 0,DIR+1
MOVE 0,@(16)
MOVEM 0,FILNAM
JSA 16, INTFIQ
SETZM DIR+2
SETZM DIR+3
LOOKUP CH,DIR
TDZA 0,0
MOVNI 0,1
JRA 16,1(16)
INTFIQ: 0 ;INITS DSK FOR INPUT
MOVEI REGS
BLT REGS+3
INIT CH,17
SIXBIT/DSK/
0
HALT .-3
; ERROR <CAN'T INIT DSK!>
INTF4: MOVE 0,FILNAM#
MOVEM 0,FN#
MOVE 1,[POINT 7,FN]
INTF3: MOVE 2,[POINT 6,DIR]
SETZM DIR
MOVEI 3,5
INTF1: ILDB 0,1
CAIN 0," "
JRST INTF2
SUBI 0,40
IDPB 0,2
SOJG 3,INTF1
INTF2: HRLZI REGS
BLT 3
JRA 16,0(16)
DIR: BLOCK 4
EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP
K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
DEFINE FIXX(N)
< JUMPGE N,.+5
MOVNS N
FIX N,233000
MOVNS N
CAIA
FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
; SUBROUTINE GETPTS
; COMMON/KNR/N(500) /NNP/NP(500)
; COMMON/XRN/RN(4000) /KJY/ K,J
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
; 1/PTR/PWDS(250),ITEM,LL,I,IX
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
; 1,(R6,RJQ(4))
GETPTS: 0 ;CALL GETPTS(N)
SETZ J, ; J=0
SETZ K, ; K=0
MOVE JJ2,POSI+=8
MOVE R2,.COMM.
;; SETZ X,
MOVE X,@(16)
SOS X
MOVEI M,PTR ; DO 1 M=1,ITEM
ADDI M,(X)
G1: AOJ X,
MOVE L,(M)
FIXX(L)
MOVEI R,XRN ;L=PWDS(M)
ADDI R,(L) ;IF(RTLINE(L))GO TO 1
MOVE 1,1(R) ;RN(L+2)
CAML R2,[=5.0]
JRST GZ
CAME R2,1
JRST GX
GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
CAME A,(R)
JRST GX
; CHECK CODE NUM
G9: MOVE A,2(R) ;IF(R6.NE.RY)GO TO 1
CAMLE A,.COMM.+6
JRST G2 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
CAMGE A,.COMM.+5 ;R4
JRST G2
SKIPG JJ2
MOVE JJ2,X
AOJ J,
; IN LIMITS?
; MOVEI A,XRN+=2498 ;J=J+1
MOVEI A,KNR-1
ADDI A,(J)
MOVEI 0,(L)
AOJ K, ;K=K+1
; MOVEI 1,XRN+=2998
MOVEI 1,NNP-1
ADDI 1,(K) ;NP(K)=L
MOVEM 0,(1)
ADDI 0,3 ;N(J)=L+3
MOVEM 0,(A)
; NP IS FOR USE IN JUSTIFY ROUTINE
G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
CAMGE RY,[=4.0]
JRST GX
CAMLE RY,[=7.0]
JRST GX ;IF(RY.GT.7)GO TO 1
; TWO-ENDED ITEM?
MOVE RZ,-1(R) ;RZ=RN(L)
; WD CNT
CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
JRST G4
CAMN RY,[=5.0]
JRST G5
CAMN RY,[=6.0]
JRST G6
CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
JRST G5 ; THERE IS A TRILL WIGGLE
JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
JRST GX
JRST G5 ;GO TO 1
G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
JRST G8
;; MOVEI 1,XRN ;IF(RN(L+10).LT.30)GO TO 8
;; ADDI 1,(L)
;; MOVE 1,11(1)
MOVE 1,=9(R)
CAMGE 1,[=30.0]
JRST G8
MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
CAMLE A,.COMM.+6
JRST G8
CAMGE A,.COMM.+5
JRST G8
SKIPG JJ2
MOVE JJ2,X
AOJ J,
; IN LIMITS?
; MOVEI A,XRN+=2498 ;J=J+1
MOVEI A,KNR-1
ADDI A,(J)
MOVEI 0,(L) ;J=J+1
ADDI 0,=8 ;N(J)=L+8
MOVEM 0,(A)
G8: CAMGE RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
JRST G5
MOVE A,6(R) ;IF(RN(L+7))GO TO G8B
JUMPL A,G8B ; P7 IS NEG FOR TREMOLO
MOVE A,7(R) ;IF(RN(L+8).NE.0)GO TO G8B
JUMPN A,G8B
CAMGE RZ,[=8.0]
JRST G5 ;IF(RZ.LT.8)GO TO G5
MOVE A,=9(R) ;IF(RN(L+10).EQ.0)GO TO G5
JUMPE A,G5 ;PASSES NUMBER OVER BEAM.
G8B: MOVE A,8(R)
CAMLE A,.COMM.+6
JRST G5
CAMGE A,.COMM.+5 ;R4
JRST G5
SKIPG JJ2
MOVE JJ2,X
AOJ J, ;J=J+1
; IN LIMITS?
; MOVEI A,XRN+=2498 ;J=J+1
MOVEI A,KNR-1
ADDI A,(J)
MOVEI 0,(L)
ADDI 0,=9 ;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
MOVEM 0,(A) ;N(J)=L+9
G5: MOVE A,5(R)
CAMLE A,.COMM.+6
JRST GX
CAMGE A,.COMM.+5 ;R4
JRST GX
SKIPG JJ2
MOVE JJ2,X
AOJ J,
; IN LIMITS?
;| MOVEI A,XRN+=2498 ;J=J+1
MOVEI A,KNR-1
ADDI A,(J)
MOVEI 0,(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
ADDI 0,6 ;N(J)=L+6
MOVEM 0,(A)
GX: CAMGE X,PTR+=250 ;1 CONTINUE
AOJA M,G1
MOVEM JJ2,POSI+=8
MOVEM J,KJY+1
MOVEM K,KJY
JRA 16,1(16)
; SUBROUTINE MOVIT
; COMMON /KNR/ N(500)
; COMMON/XRN/RN(4000) /KJY/ DONT,J
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
; 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
MOVE R,.COMM.+=10
FSBR R,.COMM.+=9
MOVE RY,.COMM.+6
FSBR RY,.COMM.+5
FDVR R,RY
; MOVEI L,XRN+=2499 ; DO 1 K=1,J
MOVEI L,KNR
SETZ K,
MOVE 0,.COMM.+=10 ; SET UP R9
M1: MOVE X,L ; L=N(K)
MOVE A,(X)
MOVEI R2,XRN ;RA=RN(L)
ADDI R2,(A)
MOVEI RZ,(R2)
MOVE R2,-1(R2)
CAMGE R2,.COMM.+5 ;IF(OUTLIM(R4,R5,RA))GO TO 1
JRST MX
CAMLE R2,.COMM.+6
JRST MX
JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
FSBR R2,.COMM.+5
FMPR R2,R
M2: FADR R2,.COMM.+=9 ; RN(L)=R8+RA
MOVEM R2,-1(RZ)
MX: AOJ K, ;1 CONTINUE
CAMGE K,KJY+1
AOJA L,M1
JRA 16,(16)
EXTEN: 0 ;FUNCTION EXTEN(X)
HRRM 16,.+2
JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
JUMP @0
JUMP [=1.0]
FMPR [=10.0]
JRA 16,1(16)
R4567: 0 ;FUNCTION R4567(R)
SETZ ;R4567=0
MOVE 1,@(16) ;IF(R.LT.4)GO TO 1
CAMGE 1,[=4.0]
JRST .+2
CAMG 1,[=7.0] ;IF(R.LE.7)RETURN
SETO ;1 R4567=-1
JRA 16,1(16) ;END
RCLEF: 0 ;FUNCTION RCLEF(R)
SETZ ;DIMENSION R(1)
MOVE 1,[=3.0] ;RCLEF=0
MOVEI 2,@(16) ;ADDR. OF R(1)
CAME 1,1(2) ;IF(R(2).NE.3)RETURN
; IS IT A CLEF?
JRA 16,1(16)
CAMLE 1,(2) ;IF(3.GE.R(1))RETURN
; IS THE WD CNT BIG ENOUGH
JRA 16,1(16)
CAMGE 1,5(2) ;IF(3.GT.R(6))RETURN
; FINDS ONLY 'REAL' CLEFS IN CODE #3
SETO ;RCLEF=-1
JRA 16,1(16) ;END
END